home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / INITIAL1.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-13  |  9KB  |  313 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  6-15-88 11:35 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit Initial1;
  14.  
  15. Interface
  16.  
  17. Uses
  18.   TPCrt, Dos, Globals, TPSTRING,
  19.   TPDOS, Core1, Core2, Initial3;
  20.   
  21.   
  22. procedure cold_start;
  23.  
  24.  
  25.   {==========================================================================}
  26.   
  27.   
  28. Implementation
  29.  
  30.  
  31.   procedure cold_start;
  32.   
  33.   var
  34.     i, try, errcnt  : Integer;
  35.     sysm_text       : Text;
  36.     t               : tad_array;
  37.     
  38.     
  39.     procedure fansi;
  40.     
  41.    {
  42.     Make sure use reset, as rewrite will create    a file
  43.     called FCON on the disk if Fansi is not here.
  44.    }
  45.    
  46.     begin
  47.       Assign(Lst, 'fcon');
  48.       {$I-}
  49.       Reset(Lst);
  50.       {$I+}
  51.       if IoResult = 0 then
  52.         begin
  53.           fconsole := True;
  54.           Close(Lst);
  55.         end
  56.       else
  57.         fconsole := False;
  58.     end { fansi } ;
  59.     
  60.     
  61.     procedure open_quote_file;
  62.       { builds QUOTES.BB# and QUOTEIDX.BB# if necessary, and opens them }
  63.       
  64.     var
  65.       rec_count       : Integer;
  66.       in_quote        : Boolean;
  67.       qtxt_file       : Text;     {file var for QUOTES.TXT}
  68.       quot_exists     : Boolean;
  69.       qtxt_exists     : Boolean;
  70.       
  71.     begin                         {procedure open_quote_file}
  72.     
  73.       Randomize;
  74.       quot_exists := ExistFile(quot_name+ext) and ExistFile(qidx_name+ext);
  75.       qtxt_exists := ExistFile(quot_name+'.TXT');
  76.       
  77.       if not quot_exists then
  78.         begin
  79.           {rebuild QUOTES.BB# and QUOTEIDX.BB# from QUOTES.TXT}
  80.           if qtxt_exists then
  81.             begin
  82.               WriteLn(Char(BEL)+quot_name+ext+' and/or '+qidx_name+ext+' not found.');
  83.               WriteLn('Rebuilding '+quot_name+ext+' and '+qidx_name+ext+'.');
  84.               Assign(quot_file, quot_name+ext);
  85.               Rewrite(quot_file);
  86.               Assign(qidx_file, qidx_name+ext);
  87.               Rewrite(qidx_file);
  88.               Assign(qtxt_file, quot_name+'.TXT');
  89.               Reset(qtxt_file);
  90.               
  91.               rec_count := 0;
  92.               in_quote := False;
  93.               while not EoF(qtxt_file) do
  94.                 begin
  95.                   ReadLn(qtxt_file, quot_rec.Text);
  96.                   quot_rec.Text := trim(quot_rec.Text);
  97.                   if (not in_quote) and (quot_rec.Text <> '') then
  98.                     begin
  99.                       in_quote := True;
  100.                       qidx_rec.loc := rec_count;
  101.                       Write(qidx_file, qidx_rec);
  102.                     end;
  103.                   if in_quote then
  104.                     begin
  105.                       Write(quot_file, quot_rec);
  106.                       Inc(rec_count);
  107.                       in_quote := quot_rec.Text <> '';
  108.                     end;
  109.                 end;
  110.               Close(qtxt_file);
  111.               Close(quot_file);
  112.               Close(qidx_file);
  113.             end;
  114.         end;
  115.         
  116.       if quot_exists or qtxt_exists then
  117.         begin
  118.           Assign(quot_file, quot_name+ext);
  119.           Reset(quot_file);
  120.           Assign(qidx_file, qidx_name+ext);
  121.           Reset(qidx_file);
  122.           quot_count := FileSize(qidx_file);
  123.         end
  124.       else
  125.         quot_count := 0;
  126.         
  127.     end;                          {procedure open_quote_file}
  128.     
  129.     
  130.     procedure build_sysm;
  131.       { Build SYSMSG.BB# file }
  132.       
  133.     var
  134.       i               : Integer;
  135.       goof, Error     : Boolean;
  136.       work            : string[80];
  137.       
  138.     begin
  139.       goof := False;
  140.       errcnt := 0;
  141.       {$I-}
  142.       Close(sysm_file) {$I+} ;    { Shouldn't erase an open file }
  143.       i := IoResult;              { Ignore any errors }
  144.       Rewrite(sysm_file);
  145.       Assign(sysm_text, current_name+'.TXT');
  146.       {$I-}
  147.       Reset(sysm_text) {$I+} ;
  148.       if IoResult = 0 then
  149.         begin
  150.           Write('  Creating ', current_name, ext);
  151.           while (not EoF(sysm_text)) and (errcnt < 50) do
  152.             begin
  153.               {$I-}
  154.               ReadLn(sysm_text, work); {$I+}
  155.               Error := (IoResult <> 0);
  156.               if Length(work) > 79 then
  157.                 begin
  158.                   sysm_rec := Copy(work, 1, 79);
  159.                   WriteLn;
  160.                   WriteLn;
  161.                   WriteLn('Line too long, truncating.');
  162.                   WriteLn;
  163.                   goof := True;
  164.                 end
  165.               else
  166.                 sysm_rec := work;
  167.               if not Error then
  168.                 Write(sysm_file, sysm_rec);
  169.               if Error then
  170.                 begin
  171.                   WriteLn;
  172.                   WriteLn;
  173.                   WriteLn('Error reading text line. No CR,LF ? ');
  174.                   goof := True;
  175.                   Inc(errcnt);
  176.                 end;
  177.             end;                  {while not eof text file}
  178.           Close(sysm_text);
  179.           Close(sysm_file);
  180.           Reset(sysm_file);
  181.           if goof or Error then
  182.             begin
  183.               WriteLn;
  184.               WriteLn(current_name,
  185.                 'TXT problem may result in parts of SYSMSG.BB# not being complete.');
  186.               WriteLn;
  187.               WriteLn('   Lines in text file should not be longer than 79 characters');
  188.               WriteLn('   or have high bits set (soft CRs) by the editor you use.');
  189.               WriteLn;
  190.               Delay(10000);
  191.             end;
  192.         end                       {ioresult=0}
  193.       else
  194.         begin
  195.           WriteLn;
  196.           Write('System message text file  ', current_name, 'TXT not found.');
  197.         end;
  198.       WriteLn;
  199.     end;
  200.     
  201.     
  202.     procedure Open_system_message;
  203.     
  204.     var
  205.       OK              : Boolean;
  206.       
  207.     begin
  208.       try := 0;
  209.       {$I-}
  210.       Reset(sysm_file) {$I+} ;    { Try to open system message file }
  211.       if IoResult <> 0 then
  212.         begin
  213.           Write('Cannot open ', current_name+ext, '.');
  214.           build_sysm;
  215.           Inc(try);
  216.         end;
  217.       {$I-}
  218.       Read(sysm_file, sysm_rec) {$I+} ; { Try to read file }
  219.       if IoResult <> 0 then
  220.         begin
  221.           OK := False;
  222.           if try = 0 then
  223.             begin
  224.               Write('Cannot read ', current_name+ext, '.');
  225.               build_sysm;
  226.               Seek(sysm_file, 0);
  227.               {$I-}
  228.               Read(sysm_file, sysm_rec); {$I+}
  229.               OK := (IoResult = 0);
  230.             end;
  231.           if not OK then
  232.             begin
  233.               WriteLn;
  234.               WriteLn('Cannot create ', current_name+ext, '.');
  235.               WriteLn('Unable to continue.');
  236.               Halt;
  237.             end;
  238.         end;
  239.       i := 0;
  240.     end;
  241.     
  242.   begin                           {cold start}
  243.     CheckBreak := False;
  244.     cold := True;
  245.     mult_cmds := False;           {no multiple commands}
  246.     Cmd_Queue := '';
  247.     if ExistFile('TPBUP.BB#') then
  248.       begin
  249.         WriteLn('TPBoard may already be resident, use ''EXIT'' to return.');
  250.         WriteLn('If that doesn''t work, erase the file ''TPBUP.BB#''.');
  251.         Halt  
  252.       end
  253.     else
  254.       begin
  255.         Assign(temp_file, 'TPBUP.BB#');
  256.         Rewrite(temp_file);
  257.         Close(temp_file);
  258.       end;
  259.     macro_in_progress := False;
  260.     GetTAD(t);
  261.     macro_done := t[3];
  262.     audit_on := False;
  263.     delay_down := False;
  264.     in_library := False;          { Start in non-library mode }
  265.     in_arc := False;
  266.     Queue := '';
  267.     
  268.     SysmBase := nil;              { Initialize pointers}
  269.     SectBase := nil;
  270.     AreaBase := nil;
  271.     MesgBase := nil;
  272.     DirBase := nil;
  273.     LibBase := nil;
  274.     Artbase := nil;
  275.     ArcBase := nil;
  276.     NetAreaBase := nil;
  277.     ExitSave := ExitProc;
  278.     ExitProc := @NewExit;
  279.     AssignAux(Com);               { Initialize output driver }
  280.     Rewrite(Com);
  281.     fansi;
  282.     GetDir(0, HomName);
  283.     HomDrv := Copy(HomName, 1, 3); { Assume system files are here }
  284.     AudName := HomName;
  285.     AudDrv := Copy(AudName, 1, 3); { default setting}
  286.     RcvName := HomName;
  287.     RcvDrv := Copy(RcvName, 1, 3);
  288.     
  289.     Assign(summ_file, summ_name+ext);
  290.     Assign(mesg_file, mesg_name+ext);
  291.     Assign(logr_file, logr_name+ext);
  292.     Assign(nwin_file, nwin_name+ext);
  293.     Assign(sysm_file, sysm_name+ext);
  294.     
  295.     current_name := sysm_name;    { Open ASCII system message file }
  296.     Open_system_message;
  297.     
  298.     Close(sysm_file);
  299.     Assign(sysm_file, sysmg_name+ext); { Open ANSI system message file }
  300.     current_name := sysmg_name;
  301.     Open_system_message;
  302.     ReadConfigFile;
  303.     ReadOrigFile;
  304.     ReadSectionFile;
  305.     open_quote_file;
  306.     if auto_macro and (t[2] < auto_macro_start) then
  307.       macro_done := t[3]-1;
  308.   end;
  309.   
  310.   
  311. end.                              { of INITIAL1.PAS }
  312. 
  313.